home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Extravaganza - Disc 4
/
Shareware Extravaganza - Over 25,000 Programs (The Ultimate Shareware Company)(Disc 4 of 4)(1993).iso
/
cad
/
jul90.zip
/
CLINE.LSP
< prev
next >
Wrap
Lisp/Scheme
|
1990-07-09
|
3KB
|
65 lines
; ***************************CLINE.LSP*************************
; Custom Linetype Program
; Copyright (c) Barry R. Bowen 1990
; -------------------------------------------------------------
; TOOLBOX Routines Used
; (LS) Create new layer (Feb '90)
; (RL) Re-set existing layer (Feb '90)
; (V1) Saves original values of system variables (Feb '89)
; (V1R) Restores original system variable values (Feb '89)
; (V3) Start-up routine (Feb '89)
; (V4) Ending routine (Feb '89)
; -------------------------------------------------------------
; Variables:
; ANG = Angle between PT1 & PT2
; BLK = Block name to insert for the linetype
; COL = Number of columns for the array
; DIST = Distance between PT1 & PT2 or line length
; LN1 = Attribute for Size
; LN2 = Attribute for Material
; MDIST = Array distance for the block BLK
; PT1 = Line start point
; PT2 = Line end point
; RE = Remainder of the Distance divided by the unit
length
; SU = Current snap unit setting
; UNL = Block unit length
; WDTH = Block width
; WN = Distance converted to an integer
; X = X scale factor
;
; SAMPLE CALL: (CLINE BLK WDTH UNL LN1 LN2)
; (CLINE "PLYWD" 0.25 1 "1/4 PLYWOOD" "")
; -------------------------------------------------------------
(defun CLINE (BLK WDTH UNL LN1 LN2 / ANG COL DIST MDIST ; 1
RE SU WN X) ; 2
(V3) ;Start-up ; 3
(V1 '("osmode" "snapmode" "attreq" "attdia" "orthomode")) ; 4
(LS "DETAIL" "7" "") ;Layer/color/linetype ; 5
(setvar "attreq" 1) ;Attribute prompt on ; 6
(setvar "attdia" 0) ;Attribute dialogue box off ; 7
(command "osnap" "none") ;Snapmode none ; 8
(setvar "orthomode" 1) ;Ortho on ; 9
(setq SU (getvar "snapunit")) ;10
(command "snap" "0.0625") ;Set snap to 1/16" ;11
(initget 1) ;Disallow null input ;12
(setq PT1 (getpoint "\nFirst Point: ")) ;13
(initget 32) ;Use dashed rubberband ;14
(setq PT2 (getpoint PT1 "\nSecond Point: ") ;15
DIST (distance PT1 PT2) ;16
ANG (angtos (angle PT1 PT2) 1 4) ;17
RE (rem DIST UNL) ;Remainder ;18
WN (fix DIST) ;Convert to an integer ;19
RE (/ RE WN) ;Used for X-scale factor ;20
COL (/ WN UNL) ;Number of columns ;21
X (1+ RE) ;X-scale factor ;22
MDIST (* UNL X) ;Array distance ;23
) ;End SetQ ;24
(command
"minsert" BLK PT1 X WDTH ANG "1" COL MDIST LN1 LN2) ;25
(setvar "snapunit" SU) ;Re-set original snap ;26
(V1R) ;Restore original variables ;27
(RL) ;Restore original layer ;28
(V4) ;Ending routine ;29
) ;End DeFun ;30